home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 98 / Skunkware 98.iso / src / interp / tclStruct1.2.tar.gz / tclStruct1.2.tar / tclStruct1.2 / stCopy.c < prev    next >
C/C++ Source or Header  |  1995-09-12  |  2KB  |  70 lines

  1. /*
  2.  *    tclStruct package
  3.  *  Support 'C' structures in Tcl
  4.  *
  5.  *  Written by Matthew Costello
  6.  *  (c) 1995 AT&T Global Information Solutions, Dayton Ohio USA
  7.  *
  8.  *  See the file "license.terms" for information on usage and
  9.  *  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  10.  */
  11. #include "stInternal.h"
  12. STRUCT_SCCSID("@(#)tclStruct:stCopy.c    1.1    95/09/08")
  13.  
  14.  
  15. /*
  16.  * struct_copy copy binary data
  17.  */
  18. int
  19. Struct_CopyCmd(cdata, interp, argc, argv)
  20.   ClientData cdata;                   /* Client Data */
  21.   Tcl_Interp *interp;                 /* Current interpreter. */
  22.   int argc;                           /* Number of arguments. */
  23.   char **argv;                        /* Argument strings. */
  24. {
  25.     Struct_Object objdst, objsrc;
  26.  
  27.     Struct_PkgInfo(cdata,si_cmdCount) += 1;
  28.     if (argc != 3) {
  29.     Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  30.           " objectDest objectSrc\"", (char *) NULL);
  31.     return TCL_ERROR;
  32.     }
  33. #ifdef DEBUG
  34.     if (struct_debug & (DBG_COMMAND)) Struct_PrintCommand(argc,argv);
  35. #endif
  36.  
  37.     if (Struct_GetObject(interp,argv[1],&objdst) == TCL_ERROR)
  38.     return TCL_ERROR;
  39.     if (Struct_GetObject(interp,argv[2],&objsrc) == TCL_ERROR) {
  40.     Struct_ReleaseType(objdst.type);
  41.     return TCL_ERROR;
  42.     }
  43.  
  44.     if (objdst.type != objsrc.type) {
  45.     Tcl_SetResult(interp,"the two objects have different types",TCL_STATIC);
  46.     Struct_ReleaseType(objdst.type);
  47.     Struct_ReleaseType(objsrc.type);
  48.     return TCL_ERROR;
  49.     }
  50.  
  51.     if (objdst.size != objsrc.size) {
  52.     Tcl_SetResult(interp,"the two objects have different sizes",TCL_STATIC);
  53.     Struct_ReleaseType(objdst.type);
  54.     Struct_ReleaseType(objsrc.type);
  55.     return TCL_ERROR;
  56.     }
  57.  
  58.     if (objdst.data == objsrc.data) {
  59.     Tcl_SetResult(interp,"the two objects are the same object",TCL_STATIC);
  60.     Struct_ReleaseType(objdst.type);
  61.     Struct_ReleaseType(objsrc.type);
  62.     return TCL_ERROR;
  63.     }
  64.  
  65.     memcpy( (char *)objdst.data, (char *)objsrc.data, objdst.size );
  66.     Struct_ReleaseType(objdst.type);
  67.     Struct_ReleaseType(objsrc.type);
  68.     return TCL_OK;
  69. }
  70.